
package Sgdb::Cntr::DumpPatches ;

use Sgdb::Utils qw(:DEFAULT
                   menu_pop_common_View
                   menu_pop_common_Edit
                   menu_pop_NB_Raise
                   bind_search_mechanism
                   save_Text_data_as
                   localconfig
                   ) ;

use warnings ;
use strict ;
use integer ;
use bytes ;


my $re = join qw(| \! \@ ======== \> \< \+ \- RCS retrieving diff \*\*\* ) ;
$re = qr{^ (?: $re ) }x ;
init() ;
sub init{ 1 }

sub new {

    my ($self, $topf ) = @_ ;

    my $t = $topf->Scrolled ('ROText',
                             -takefocus => 1,
                             pref 'dump-patches-text' ,
                            ) ;

    pref_reconfigure  'dump-patches-text' => $t  ;

    for my $tag qw( fix-name
                    unchanged
                    changed
                    header
                    name
                  ) { $t -> tagConfigure ( $tag, pref "dump-patches-$tag-tag" ) }

    { # menu
        my $m = $t -> menu() ;
        $m -> delete ( 0 => 'end' ) ;
        my $view = $m -> Menu ( -tearoff => 0, pref 'pop-menu' ) ;
        menu_pop_common_View ( $t, $view ) ;
        my $edit = $m -> Menu ( -tearoff => 0, pref 'pop-menu' ) ;
        menu_pop_common_Edit ( $t, $edit ) ;

        for my $menu ( [ command  =>
                         -label   => 'Show Source',
                         -command => [\&info_line, $t],
                       ] ,
                       ['separator'],
                       [ cascade  =>
                         -label   => 'View',
                         -menu    => $view
                       ],
                       [ cascade  =>
                         -label   => 'Edit',
                         -menu    => $edit
                       ],
                       [ 'separator' ],
                       [ command  =>
                         -label   => 'Save As',
                         -command => [\&save_Text_data_as, $t, 'last-dump-patches-filename' ]
                       ],
                       [ command  =>
                         -label => 'Close',
                         -command => [\&hook_run, 'close-current-source-pane']
                       ] ) { $m -> add ( @$menu ) }
    }

    bind_search_mechanism( $t ) ;
    hook_add 'dump-all-patches' => [\&show_pathes, $t] ;
    $t -> bind ('<Control-1>', [\&info_line, $t]) ;

    $t ;
}

sub show_pathes {

    my $t = shift ;
    return telme 'no text' unless istkwidget $t ;
    $_ = gdb_cached ('syren-v') || '' ;

    my ($major, $minor ) = /\"\s*(\d+)\s+(\d+)/ ;
    $minor or return telthemloud "cannot determine minor release" ;

    my @fr = /(\d+),(\d+)/g ;

    my $file = gdb_cached 'file' ;
    $t -> delete ('1.0' => 'end' ) ;
    $t -> insert ( 'end',
                   "fix list for $file\n\n" => 'head',
                   ) ;

    while ( @fr ) {

        my $fix = shift @fr ;
        my $rev = shift @fr ;
        my $dat = localconfig ( 'get-one-syren-fix' ,
                                $major, $minor, $fix, $rev ) ;
        my $who = localconfig ( 'get-one-syren-fix-devloper',
                                $major, $minor, $fix, $rev ) || '???' ;

        $t -> insert ( 'end',
                       "\n===== $who: $fix,$rev ===== \n\n" => 'fix-name',
                       map { ( $_,
                               /$re/    ? 'changed' :
                               /^Index/ ? 'name'    :
                                          'unchanged' )
                         }
                       split /^/, $dat
                     ) ;

        $t -> idletasks () ;
        $t -> see ( 'end' ) ;
    }
}

sub info_line {
    my $t = shift ;
    my $c = $t -> index ('current') ;
    my $d = "-1 l" ;
    my ($sanity, $file, $line) = 300 ;
    until ($file and $line and $sanity ) {
        $_ = $t -> get ( "$c linestart", "$c lineend" ) ;
        unless ($line) {
            /^\S\W+.*?(\d+),\d+\W+$/ and $line = $1 ;
        }
        unless ($file) {
            /^(?:\+\+\+|Index).*?(\w+\.\w+)/ and $file = $1 ;
            $d = "+1 l" if $file ;
        }
        $c = $t -> index ( "$c $d" ) ;
    }
    $file or return telthemloud "can't determine source name" ;
    $line ||= 1 ;
    gdb_exec_lock "info line $file:$line" ;
}

'end'
